home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 008a / feb93cad.zip / KSRC_KEY.LSP < prev    next >
Text File  |  1993-02-12  |  5KB  |  175 lines
  1. ; KSRC_KEY.LSP
  2. ;
  3. ;    THIS ROUTINE PLACES THE CURRENT DRAWING'S SYSTEM KEY IN THE EXTENDED
  4. ;    DATA OF SELECTED ENTITES.  THE INFORMATION IS REGISTERED UNDER
  5. ;    THE APPLICATION NAME OF
  6. ;
  7. ;    KENT_44240_GIS_SOURCE
  8. ;
  9. ;    FOR SOURCE DRAWING SYSTEM KEY, AND
  10. ;
  11. ;    KENT_44240_GIS_INPUT
  12. ;
  13. ;    FOR INPUT DRAWING SYSTEM KEY.
  14. ;
  15. ;    THE INFORMATION RECORDED UNDER THESES APPLICATIONS IS INTENDED TO
  16. ;    PROVIDE TRACKING OF THE ENTITIES' SOURCE AND INPUT DRAWINGS
  17. ;    FOR GIS INPUT.
  18. ;
  19. ; ********** BEGIN XD_CHECK **********
  20. (defun XD_CHECK ()
  21. (IF (ASSOC -3 ENTDSC)        ; IF THERE IS EXTENDED DATA
  22.     (PROGN
  23.         (SETQ ENTDAT (ASSOC -3 ENTDSC))
  24.         (SETQ APPLIST (CDR ENTDAT))    ; GET RID OF -3
  25.         (IF  (SETQ APPCUR (ASSOC APPNAME APPLIST))
  26.             ( XD_EDIT )
  27.             ( XD_ADD )
  28.         )
  29.         ( XD_BUILD )
  30.     )
  31.     (PROGN            ; IF THERE IS NO EXTENDED DATA
  32.         ( XD_MAKE )    ; CREATE APPLICATION XDATA 
  33.     )
  34. )
  35. )    ; ********** END XD_CHECK **********
  36.     ; ********** BEGIN XD_EDIT **********
  37. (defun XD_EDIT ()
  38.     (IF APPUPDT
  39.         (PROGN
  40.             (PRINC "\n")
  41.             (PRINC (ASSOC 1000 (CDR APPCUR) ))
  42.             (PRINC "\n CHANGED TO \n")
  43.             (PRINC (ASSOC 1000 (CDR APPSET) ))
  44.             (SETQ APPCUR APPSET)
  45.             (SETQ APPCUR APPCUR)
  46.             (Setq DIDIT (+ 1 DIDIT))
  47.         )
  48.         (PROGN
  49.             (PRINC "\n")
  50.             (PRINC (ASSOC 1000 (CDR APPCUR) ))
  51.             (PRINC "\n NOT CHANGED \n")
  52.         )
  53.     )
  54. )    ; ********** END XD_EDIT **********
  55.     ; ********** BEGIN XD_ADD **********
  56. (defun XD_ADD ()
  57. (SETQ APPCUR APPSET)
  58. (SETQ APPLIST (CONS APPCUR APPLIST))
  59. (Setq DIDIT (+ 1 DIDIT))
  60. )    ; ********** END XD_ADD **********
  61.     ; ********** BEGIN XD_BUILD **********
  62. (defun XD_BUILD ()
  63. (SETQ APPLIST 
  64.     (SUBST    APPCUR
  65.         (ASSOC APPNAME APPLIST)
  66.         APPLIST
  67.     )
  68. )
  69. (SETQ ENTDAT (CONS -3 APPLIST))
  70. (SETQ ENTDSC
  71.     (SUBST    ENTDAT
  72.         (ASSOC -3 ENTDSC)
  73.         ENTDSC
  74.     )
  75. )
  76. (IF (ENTMOD ENTDSC)
  77.     (PRINC "\nDATA POSTED TO ENTITY")
  78.     (PRINC "\nNO DATA POSTED TO ENTITY")
  79. )
  80. (SETQ APPLIST NIL)
  81. )    ; ********** END XD_BUILD **********
  82.     ; ********** BEGIN XD_MAKE **********
  83. (defun XD_MAKE ()
  84.     (SETQ APPCUR APPSET)
  85.     (SETQ ENTDAT (LIST -3 APPCUR))
  86.     (SETQ ENTDSC (CONS ENTDAT ENTDSC))
  87.     (IF (ENTMOD ENTDSC)
  88.         (PRINC "\nDATA POSTED TO ENTITY")
  89.         (PRINC "\nNO DATA POSTED TO ENTITY")
  90.     )
  91.     (Setq DIDIT (+ 1 DIDIT))
  92. )    ; ********** END XD_MAKE **********
  93.     ; ********** BEGIN XD_MSG1 **********
  94. (defun XD_MSG1 ()
  95.     (PRINC "\n TRYING TO ADD EXTEDED DATA TO ")
  96.     (PRINC ENTTYPE)
  97.     (PRINC " ENTITY.")
  98.     (SETQ EDANS2 
  99.         (GETSTRING "\n O.K. TO PROCEED? (Y/N): ")
  100.     )
  101.     (IF (OR (= EDANS2 "Y") (= EDANS2 "y"))
  102.         (XD_CHECK)
  103.     )
  104. )    ; ********** END XD_MSG1 **********
  105.     ; ********** BEGIN C:SRC_KEY **********
  106. (defun C:SRC_KEY ()
  107.     (SETQ SRCFIL (strcat (getvar "dwgprefix") (getvar "dwgname") ) )
  108.     (SETQ SRCDATE (GETVAR "CDATE") )
  109.     (SETQ SRCDATE (RTOS SRCDATE 2 9) )
  110.     (TEXTPAGE)
  111.     (PRINC SRCFIL )
  112.     (PRINC " - ")
  113.     (PRINC SRCDATE)
  114.     (PRINC "\n")
  115.     (SETQ APPICK (GETSTRING T "\nREGISTER SOURCE KEY FOR THIS DRAWING (Y/N): "))
  116.     (IF (OR (= APPICK "Y") (= APPICK "y"))
  117.         (SETQ APPNAME "KENT_44240_GIS_SOURCE")
  118.         (SETQ APPNAME "KENT_44240_GIS_INPUT")
  119.     )
  120.     (IF (NOT
  121.          (SETQ SRCKEY (GETSTRING T "\nENTER SOURCE KEY FOR THIS DRAWING: "))
  122.         )
  123.         (SETQ SRCKEY "NONE")
  124.     )
  125. ;        BUILD XDATA FOR APPLICATION
  126.     (SETQ APPSET (LIST '(1002 . "}")))
  127.     (SETQ APPCODE 1000)
  128.     (SETQ APP_VAL SRCKEY)
  129.     (SETQ APPSET (CONS (CONS APPCODE APP_VAL) APPSET))
  130.     (SETQ APPSET (CONS '(1002 . "{") APPSET))
  131.     (SETQ APPSET (CONS APPNAME APPSET))
  132. ;        PROCESS SELECTED ENTITIES
  133.     (IF  (REGAPP APPNAME)
  134.         (PROGN
  135.             (PRINC "\nNEW APPLICATION REGISTERED: ")
  136.             (PRINC APPNAME)
  137.         )
  138.         (PROGN
  139.             (PRINC "\nEXISTING APPLICATION: ")
  140.             (PRINC APPNAME)
  141.             (SETQ EDANS1 
  142.                 (GETSTRING T "\nCHANGE EXISTING XDATA? (Y/N) ")
  143.             )
  144.             (IF (OR (= EDANS1 "Y") (= EDANS1 "y"))
  145.                 (SETQ APPUPDT 1)    ; CHANGE EXISTING XDATA
  146.                 (SETQ APPUPDT NIL)    ; DON'T CHANGE 
  147.             )
  148.         )
  149.     )
  150.     (GRAPHSCR)
  151.     (Prompt "\nPick ENTITIES TO PROCESS")
  152.     (Setq D 0)
  153.     (Setq DIDIT 0)
  154.     (Setq E (Ssget))
  155.     (Setq F (Sslength E))
  156.     (Repeat F
  157.         (Setq G (Ssname E D))
  158.         (IF (XDROOM G)
  159.           (PROGN
  160.             (Setq ENTDSC (Entget G (list "*")))
  161.             ( XD_CHECK )
  162.           )
  163.         )
  164.         (Setq D (+ 1 D))
  165.     )
  166.     (PRINC "\n")
  167.     (PRINC D)
  168.     (PRINC " ENTITIES PROCESSED.\n")
  169.     (PRINC DIDIT)
  170.     (PRINC " ENTITIES XDATA PROCESSED.")
  171.     (PRINC )
  172. )    ; ********** END C:SRC_KEY **********
  173.  
  174. 
  175.